home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 1995 #2 / Amiga Plus CD - 1995 - No. 2.iso / pd / mui / mirrormanager / rexx / sortindex.mm < prev    next >
Text File  |  1995-04-11  |  13KB  |  450 lines
  1. /*
  2.     $VER: $Id: SortIndex.mm,v 1.2 1994/06/20 01:08:30 tf Exp $
  3.  
  4.     This script sorts an Aminet index file either by the filenames
  5.     or by the pathname.  LONG index files are supported.
  6.  
  7.     Unless you do not pass the QUICK option, the index header will
  8.     remain unchaned and the given FILE or DIR option sets the
  9.     primary sort creterium.
  10.     If on the other hand the QUICK option has been seen, SortIndex
  11.     will use no secondary search creterium and it will destroy
  12.     the index file header.
  13.  
  14.     This ARexx script needs the AmigaDOS commands "Sort", "Rename",
  15.     and "Delete" available in your path.
  16.  
  17.     Initial revision by Tobias Ferber, 30.4.94
  18. */
  19.  
  20. options results
  21. options failat 21
  22.  
  23. CALL PRAGMA('S',102400)
  24.  
  25. /* initialize globals */
  26.  
  27. template   = "FROM/K/A,FILE/S,DIR/S,QUICK/S,AUTO/S"
  28. filename   = ""
  29. tempfile   = ""
  30. oldfile    = ""
  31. args       = ""
  32. cliopts    = ""
  33.  
  34. dg       = 0  /* gauge increment */
  35. ESC      = '1b'x
  36.  
  37. signal on HALT
  38. signal on BREAK_C
  39. signal on BREAK_D
  40.  
  41.  
  42. /* parse args */
  43.  
  44. do ac=1 while ac <= arg()
  45.   av= arg(ac)
  46.   select
  47.     when upper(av) = "FROM" then do
  48.       if ac < arg() then do
  49.         ac= ac+1
  50.         filename= arg(ac)
  51.         end
  52.       else exit bad_args('Missing filename after' ESC'bFROM'ESC'n keyword.')
  53.       end /* FROM */
  54.  
  55.     when upper(av) = "FILE" then do
  56.       if (lastpos('d',cliopts) < 1) then cliopts = cliopts || 'f'
  57.       else exit bad_args('Only one of' ESC'bFILE'ESC'n or' ESC'bDIR'ESC'n is allowed.')
  58.       end /* FILE */
  59.  
  60.     when upper(av) = "DIR" then do
  61.       if (lastpos('f',cliopts) < 1) then cliopts = cliopts || 'd'
  62.       else exit bad_args('Only one of' ESC'bFILE'ESC'n or' ESC'bDIR'ESC'n is allowed.')
  63.       end /* DIR */
  64.  
  65.     when upper(av) = "QUICK" then cliopts = cliopts || 'q'
  66.     when upper(av) = "AUTO"  then cliopts = cliopts || 'a'
  67.  
  68.     otherwise exit bad_args('Unknown keyword:' ESC'b' || av || ESC'n')
  69.  
  70.     end /* select */
  71.  
  72.   end /* do */
  73.  
  74. call pragma('W','N')
  75.  
  76.  
  77. /* eventually try to get missing from file */
  78.  
  79. if words(filename) < 1 then do
  80.   cwd= strip(pragma('D'),'B','"')
  81.   REQUESTFILE DRAWER '"'cwd'"' TITLE '"Select index file to sort..."' NOICONS
  82.   if (rc=0) & (words(result) > 0) & (result ~= 'RESULT') then filename= result
  83.   end
  84.  
  85. if words(filename) < 1 then
  86.   exit bad_args("Not enough arguments for SortIndex...*nExiting...")
  87.  
  88. if (words(filename) > 0) & ~exists(filename) then do
  89.   REQUESTCHOICE TITLE   '"SortIndex Request"',
  90.                 BODY    '"SortIndex failed to locate your FROM file*n*n' ||,
  91.                         ESC'c'ESC'b' || filename || ESC'n'ESC'l'         || '"',
  92.                 GADGETS '"Exit"'
  93.   exit 10
  94.   end
  95.  
  96. if (pos('f',cliopts) < 1) & (pos('d',cliopts) < 1) then do
  97.   REQUESTCHOICE TITLE   '"SortIndex Request"',
  98.                 BODY    '"Select the sort creterium for*n*n'        ||,
  99.                         ESC'c'ESC'b' || filename || ESC'n'ESC'l'   || '"',
  100.                 GADGETS '"_Filename|_Directory|_Cancel"'
  101.  
  102.   if (rc=0) & (words(result) > 0) & (result ~= 'RESULT') then select
  103.     when result = '1' then cliopts= cliopts || 'f'
  104.     when result = '2' then cliopts= cliopts || 'd'
  105.     otherwise              cliopts= ""
  106.     end
  107.  
  108.   end
  109.  
  110. if words(cliopts) < 1 then exit
  111.  
  112. signal on ERROR
  113. signal on IOERR
  114.  
  115. signal on FAILURE
  116. /*signal on NOVALUE*/
  117. signal on SYNTAX
  118.  
  119.  
  120. /* do the hard part */
  121.  
  122. MESSAGE CLEAR; MESSAGE OPEN; COMPLETE 0
  123. if pos('d',cliopts) > 0 then do; scol= 22; WORKING '"Sorting' filename 'by directory ..."'; end
  124.                         else do; scol=  1; WORKING '"Sorting' filename 'by filename ..."' ; end
  125.  
  126. COMPLETE 5
  127.  
  128. IF POS('q',cliopts) > 0 THEN DO
  129.  
  130.   tempfile= filename || '.' || pragma('Id')
  131.  
  132.   MESSAGE transquote('Renaming "'filename'" to "'tempfile'" ...')
  133.   IF EXISTS(tempfile) THEN ADDRESS COMMAND 'Delete QUIET FILE "'tempfile'"'
  134.   ADDRESS COMMAND 'Rename QUIET FROM "'filename'" TO "'tempfile'"'
  135.  
  136.   COMPLETE 10
  137.  
  138.   MESSAGE transquote('Sorting "'tempfile'" to "'filename'" ...')
  139.   ADDRESS COMMAND 'Sort FROM "'tempfile'" TO "'filename'" COLSTART' scol
  140.  
  141.   COMPLETE 90
  142.  
  143.   MESSAGE transquote('Deleting temprary index file "'tempfile'" ...')
  144.   ADDRESS COMMAND 'Delete QUIET FILE "'tempfile'"'
  145.   END
  146.  
  147. ELSE DO /* Save index header */
  148.  
  149.   tempfile= "T:" || fileonly(filename) || '.' || pragma('Id')
  150.   oldfile= filename || '.OLD'
  151.  
  152.   IF EXISTS(oldfile) THEN DO
  153.     REQUESTCHOICE TITLE   '"SortIndex Request"',
  154.                   BODY    '"Ooops!  Index backup file*n*n'             ||,
  155.                           ESC'c'ESC'b' || oldfile || ESC'n'ESC'l*n*n'  ||,
  156.                           'already exists.  May I replace it?'       || '"',
  157.                   GADGETS '"**_Yes|_No"'
  158.  
  159.     IF result = 0 THEN DO
  160.       REQUESTCHOICE TITLE '"SortIndex Request"' BODY '"SortIndex canceled"' GADGETS '"Exit"'
  161.       EXIT
  162.       END
  163.  
  164.     MESSAGE transquote('Deleting "'oldfile'" ...')
  165.     ADDRESS COMMAND 'Delete QUIET FILE "'oldfile'"'
  166.     END
  167.  
  168.   COMPLETE 10
  169.   MESSAGE transquote('Renaming "'filename'" to "'oldfile'" ...')
  170.   ADDRESS COMMAND 'Rename QUIET FROM "'filename'" TO "'oldfile'"'
  171.  
  172.   COMPLETE 20
  173.   MESSAGE transquote('Writing header to "'filename'" ...')
  174.  
  175.   IF ~OPEN('in',oldfile,'R') THEN DO
  176.     REQUESTCHOICE TITLE   '"SortIndex Request"',
  177.                   BODY    '"Failed to open your old index file*n*n' ||,
  178.                           ESC'c'ESC'b' || oldfile || ESC'n'ESC'l'   || '"',
  179.                   GADGETS '"Exit"'
  180.     EXIT
  181.     END
  182.  
  183.   COMPLETE 25
  184.  
  185.   IF ~OPEN('out',filename,'W') THEN DO
  186.     REQUESTCHOICE TITLE   '"SortIndex Request"',
  187.                   BODY    '"Could not write to*n*n'                ||,
  188.                           ESC'c'ESC'b' || filename || ESC'n'ESC'l' || '"',
  189.                   GADGETS '"Exit"'
  190.     EXIT
  191.     END
  192.  
  193.   COMPLETE 30
  194.  
  195.   line= "|"
  196.   DO UNTIL (LEFT(line,1) ~= '|') | EOF('in')
  197.     line= READLN('in')
  198.     IF LEFT(line,1) = '|' THEN WRITELN('out',line)
  199.     END
  200.  
  201.   CALL CLOSE('out')
  202.  
  203.   COMPLETE 40
  204.   MESSAGE transquote('Generating temporary index file "'tempfile'" ...')
  205.  
  206.   IF ~OPEN('out',tempfile,'W') THEN DO
  207.     REQUESTCHOICE TITLE   '"SortIndex Request"',
  208.                   BODY    '"Could not write to*n*n'                ||,
  209.                           ESC'c'ESC'b' || tempfile || ESC'n'ESC'l' || '"',
  210.                   GADGETS '"Exit"'
  211.     EXIT
  212.     END
  213.  
  214.   COMPLETE 45
  215.   numentries= 0
  216.  
  217.   /* write tempfile for a sort by dir */
  218.   IF POS('d',cliopts) > 0 THEN DO UNTIL EOF('in')
  219.     PARSE VAR line fname pname . 33 rest
  220.     CALL WRITELN('out',pname || '09'x || fname || '09'x || rest)
  221.     numentries= numentries +1
  222.     line= READLN('in')
  223.     END
  224.  
  225.   /* write tempfile for a sort by file */
  226.   ELSE DO UNTIL EOF('in')
  227.     PARSE VAR line fname pname . 33 rest
  228.     CALL WRITELN('out',fname || '09'x || pname || '09'x || rest)
  229.     numentries= numentries +1
  230.     line= READLN('in')
  231.     END
  232.  
  233.   COMPLETE 70
  234.  
  235.   /* initialize the gauge increment */
  236.   IF numentries > 0 THEN dg = 100 / numentries
  237.  
  238.   CALL CLOSE('out')
  239.   CALL CLOSE('in')
  240.  
  241.   COMPLETE 75
  242.  
  243.   MESSAGE transquote('Sorting "'tempfile'" ...')
  244.   ADDRESS COMMAND 'Sort FROM "'tempfile'" TO "'tempfile'"'
  245.  
  246.   COMPLETE 90
  247.   MESSAGE transquote('Appending "'tempfile'" to "'filename'" ...')
  248.  
  249.   IF ~OPEN('in',tempfile,'R') THEN DO
  250.     REQUESTCHOICE TITLE   '"SortIndex Request"',
  251.                   BODY    '"Could not read from*n*n'               ||,
  252.                           ESC'c'ESC'b' || tempfile || ESC'n'ESC'l' || '"',
  253.                   GADGETS '"Exit"'
  254.     EXIT
  255.     END
  256.  
  257.   COMPLETE 95
  258.  
  259.   IF ~OPEN('out',filename,'A') THEN DO
  260.     REQUESTCHOICE TITLE   '"SortIndex Request"',
  261.                   BODY    '"Could not write to*n*n'                ||,
  262.                           ESC'c'ESC'b' || filename || ESC'n'ESC'l' || '"',
  263.                   GADGETS '"Exit"'
  264.     EXIT
  265.     END
  266.  
  267.   COMPLETE 100
  268.  
  269.   /* read tempfile sorted by dir */
  270.   IF POS('d',cliopts) > 0 THEN DO UNTIL EOF('in')
  271.     line= READLN('in')
  272.     numentries= numentries - 1;
  273.     COMPLETE 100 - TRUNC( MAX(numentries * dg,0) )
  274.     IF WORDS(line) > 0 THEN DO
  275.       PARSE VAR line pname '09'x fname '09'x rest
  276.       CALL WRITELN('out', LEFT(fname,20,' ') || ' ' ||,
  277.                           LEFT(pname,10,' ') || ' ' ||  rest)
  278.       END
  279.     END
  280.  
  281.   /* read tempfile sorted by file */
  282.   ELSE DO UNTIL EOF('in')
  283.     line= READLN('in')
  284.     numentries= numentries - 1;
  285.     COMPLETE 100 - TRUNC( MAX(numentries * dg,0) )
  286.     IF WORDS(line) > 0 THEN DO
  287.       PARSE VAR line fname '09'x pname '09'x rest
  288.       CALL WRITELN('out', LEFT(fname,20,' ') || ' ' ||,
  289.                           LEFT(pname,10,' ') || ' ' ||  rest)
  290.       END
  291.     END
  292.  
  293.   CALL CLOSE('out')
  294.   CALL CLOSE('in')
  295.  
  296.   MESSAGE transquote('Deleting old index file "'oldfile'" ...')
  297.   ADDRESS COMMAND 'Delete QUIET FILE "'oldfile'"'
  298.  
  299.   MESSAGE transquote('Deleting temprary index file "'tempfile'" ...')
  300.   ADDRESS COMMAND 'Delete QUIET FILE "'tempfile'"'
  301.  
  302.   END /* Save index header */
  303.  
  304. COMPLETE 100
  305. MESSAGE '"done."'
  306. IF POS('a',cliopts) > 0 THEN MESSAGE CLOSE
  307. exit 0
  308.  
  309.  
  310. bad_args: PROCEDURE EXPOSE template ESC
  311.   PARSE ARG msg
  312.   REQUESTCHOICE TITLE   '"SortIndex Request"',
  313.                 BODY    '"' || msg || '*n*n'                     ||,
  314.                         'SortIndex args template:*n*n'           ||,
  315.                         ESC'c'ESC'b' || template || ESC'n'ESC'l' || '"',
  316.                 GADGETS '"Okay"'
  317.   RETURN 0
  318.  
  319. /*@*/
  320.  
  321.  
  322. /* translate '"' into '*"' and '*' into '**' */
  323.  
  324. transquote: procedure
  325.   parse arg s
  326.   t= s
  327.   q= max( lastpos('*',s), lastpos('"',s) )
  328.   do while q > 0
  329.     t= insert('*',t,q-1,1)
  330.     s= left(s,q-1)
  331.     q= max( lastpos('*',s), lastpos('"',s) )
  332.     end
  333.   return '"' || t || '"'
  334.  
  335.  
  336. /* return the non-file part of a pathname */
  337.  
  338. pathonly: procedure
  339.   parse arg path
  340.   if (words(path) > 0) & (right(path,1) ~= ':') then do
  341.     if right(path,1) = '/' then path= left(path,length(path)-1)
  342.     if lastpos('/',path) > lastpos(':',path) then path= left(path,lastpos('/',path)-1)
  343.                                              else path= left(path,lastpos(':',path))
  344.     end
  345.   return path
  346.  
  347.  
  348. /* return the file part of a pathname */
  349.  
  350. fileonly: procedure
  351.   parse arg path
  352.   if right(path,1) = '/' then path= left(path,length(path)-1)
  353.   p= max( lastpos(':',path), lastpos('/',path) )
  354.   if(p>0) then return substr(path,p+1)
  355.           else return path
  356.  
  357.  
  358. /* concatenate the filename to the pathname and return the resulting string */
  359.  
  360. tackon: procedure
  361.   parse arg path,file
  362.   do while left(file,1) = '/'
  363.     file= substr(file,2)
  364.     path= pathonly(path)
  365.     end
  366.   if (words(path) > 0) & (right(path,1) ~= '/') & (right(path,1) ~= ':') then path= path || '/'
  367.   if (right(file,1) = '/') then file= left(file,length(file)-1)
  368.   return path || file
  369.  
  370.  
  371. /* create all non-existant directories in a path */
  372.  
  373. makepath: procedure
  374.   parse arg path
  375.   if right(path,1) = '/' then path= left(path,length(path)-1)
  376.   if ~exists(path) then do
  377.     call makepath( pathonly(path) )
  378.     address command 'MakeDir NAME "'path'"'
  379.     end
  380.   return 0
  381.  
  382.  
  383. /*
  384.  * return   1  if the device or volume name in given pathname exists
  385.  *             or if no device or volume was present (current device)
  386.  *          0  if the device or volume name does not exist
  387.  */
  388.  
  389. canexist: procedure
  390.   parse upper arg path
  391.   if pos(':',path) < 1 then return 1 /* current device */
  392.   call pragma('W','N')
  393.   return exists( left(path,lastpos(':',path)) )
  394.  
  395.  
  396. /* error/break handling */
  397.  
  398. IOERR:
  399. ERROR:
  400.   err= rc
  401.   ESC = '1b'x
  402.  
  403.   signal off ERROR
  404.   signal off IOERR
  405.  
  406.   WORKING '"I/O problem trapped... Execution halted."'
  407.   MESSAGE '"I/O problem trapped... Execution halted."'
  408.  
  409.   REQUESTCHOICE TITLE   '"SortIndex Error Trap' err'"',
  410.                 BODY    '"There was a problem with external I/O in line' sigl '...*n' ||,
  411.                         ESC'c'ESC'b' || ERRORTEXT(err) || ESC'n'ESC'l'                || '"',
  412.                 GADGETS '"I''ll better exit"'
  413.   exit
  414.  
  415.  
  416. FAILURE:
  417. NOVALUE:
  418. SYNTAX:
  419.   err= rc
  420.   ESC = '1b'x
  421.  
  422.   signal off FAILURE
  423.   signal off NOVALUE
  424.   signal off SYNTAX
  425.  
  426.   WORKING '"Internal problem trapped... Execution halted."'
  427.   MESSAGE '"Internal problem trapped... Execution halted."'
  428.  
  429.   REQUESTCHOICE TITLE   '"SortIndex Internal Error' err'"',
  430.                 BODY    '"SortIndex seems to have an internal problem in line' sigl '...*n' ||,
  431.                         ESC'c'ESC'b' || ERRORTEXT(err) || ESC'n'ESC'l'                      || '"',
  432.                 GADGETS '"I''ll better exit"'
  433.   exit
  434.  
  435.  
  436. HALT:
  437. BREAK_C:
  438. BREAK_D:
  439.   signal off HALT
  440.   signal off BREAK_C
  441.   signal off BREAK_D
  442.  
  443.   WORKING '"Break signal trapped... Execution halted."'
  444.   MESSAGE '"Break signal trapped... Execution halted."'
  445.  
  446.   REQUESTCHOICE TITLE   '"SortIndex Break Trap"',
  447.                 BODY    '"Script execution halted."',
  448.                 GADGETS '"Stop"'
  449.   exit
  450.